home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / ELECTRIC / DSPICE0S.ZIP / outnam.c < prev    next >
C/C++ Source or Header  |  1992-11-22  |  9KB  |  272 lines
  1. /* outnam.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     doublereal value[200000];
  26. } blank_;
  27.  
  28. #define blank_1 blank_
  29.  
  30. /* Table of constant values */
  31.  
  32. static integer c__1 = 1;
  33.  
  34. /*<       subroutine outnam(loc,ktype,string,ipos) >*/
  35. /* Subroutine */ int outnam_(loc, ktype, string, ipos)
  36. integer *loc, *ktype;
  37. doublereal *string;
  38. integer *ipos;
  39. {
  40.     /* Initialized data */
  41.  
  42.     static struct {
  43.     char e_1[8];
  44.     doublereal e_2;
  45.     } equiv_19 = { {' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  46.  
  47. #define ablnk (*(doublereal *)&equiv_19)
  48.  
  49.     static struct {
  50.     char e_1[152];
  51.     doublereal e_2;
  52.     } equiv_20 = { {'v', ' ', ' ', ' ', ' ', ' ', ' ', ' ', 'v', 'm', ' ',
  53.          ' ', ' ', ' ', ' ', ' ', 'v', 'r', ' ', ' ', ' ', ' ', ' ', 
  54.         ' ', 'v', 'i', ' ', ' ', ' ', ' ', ' ', ' ', 'v', 'p', ' ', 
  55.         ' ', ' ', ' ', ' ', ' ', 'v', 'd', 'b', ' ', ' ', ' ', ' ', 
  56.         ' ', 'i', ' ', ' ', ' ', ' ', ' ', ' ', ' ', 'i', 'm', ' ', 
  57.         ' ', ' ', ' ', ' ', ' ', 'i', 'r', ' ', ' ', ' ', ' ', ' ', 
  58.         ' ', 'i', 'i', ' ', ' ', ' ', ' ', ' ', ' ', 'i', 'p', ' ', 
  59.         ' ', ' ', ' ', ' ', ' ', 'i', 'd', 'b', ' ', ' ', ' ', ' ', 
  60.         ' ', 'o', 'n', 'o', 'i', 's', 'e', ' ', ' ', 'i', 'n', 'o', 
  61.         'i', 's', 'e', ' ', ' ', 'h', 'd', '2', ' ', ' ', ' ', ' ', 
  62.         ' ', 'h', 'd', '3', ' ', ' ', ' ', ' ', ' ', 'd', 'i', 'm', 
  63.         '2', ' ', ' ', ' ', ' ', 's', 'i', 'm', '2', ' ', ' ', ' ', 
  64.         ' ', 'd', 'i', 'm', '3', ' ', ' ', ' ', ' '}, 0. };
  65.  
  66. #define aout ((doublereal *)&equiv_20)
  67.  
  68.     static integer lenout[19] = { 1,2,2,2,2,3,1,2,2,2,2,3,6,6,3,3,4,4,4 };
  69.     static struct {
  70.     char e_1[40];
  71.     doublereal e_2;
  72.     } equiv_21 = { {'m', 'a', 'g', ' ', ' ', ' ', ' ', ' ', 'r', 'e', 'a',
  73.          'l', ' ', ' ', ' ', ' ', 'i', 'm', 'a', 'g', ' ', ' ', ' ', 
  74.         ' ', 'p', 'h', 'a', 's', 'e', ' ', ' ', ' ', 'd', 'b', ' ', 
  75.         ' ', ' ', ' ', ' ', ' '}, 0. };
  76.  
  77. #define aopt ((doublereal *)&equiv_21)
  78.  
  79.     static integer lenopt[5] = { 3,4,4,5,2 };
  80.     static struct {
  81.     char e_1[8];
  82.     doublereal e_2;
  83.     } equiv_22 = { {'(', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  84.  
  85. #define alprn (*(doublereal *)&equiv_22)
  86.  
  87.     static struct {
  88.     char e_1[8];
  89.     doublereal e_2;
  90.     } equiv_23 = { {',', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  91.  
  92. #define acomma (*(doublereal *)&equiv_23)
  93.  
  94.     static struct {
  95.     char e_1[8];
  96.     doublereal e_2;
  97.     } equiv_24 = { {')', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  98.  
  99. #define arprn (*(doublereal *)&equiv_24)
  100.  
  101.  
  102.     /* Local variables */
  103.     static doublereal anam;
  104.     static integer locv;
  105.     extern /* Subroutine */ int move_();
  106.     static integer lout, node1, node2, i;
  107.     static doublereal achar;
  108. #define nodplc ((integer *)&blank_1)
  109. #define cvalue ((complex *)&blank_1)
  110.     extern /* Subroutine */ int alfnum_();
  111.     static integer ioutyp;
  112.  
  113.     /* Parameter adjustments */
  114.     --string;
  115.  
  116.     /* Function Body */
  117. /*<       implicit double precision (a-h,o-z) >*/
  118.  
  119. /*     this routine constructs the 'name' for the output variable indi- */
  120.  
  121. /* cated by loc, adding the characters to the character array 'string', */
  122.  
  123. /* beginning with the position marked by ipos. */
  124.  
  125. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  126. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  127. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  128. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  129. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  130. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  131. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  132. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  133. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  134. /* spice version 2g.6  sccsid=blank 3/15/83 */
  135. /*<       common /blank/ value(200000) >*/
  136. /*<       integer nodplc(64) >*/
  137. /*<       complex cvalue(32) >*/
  138. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  139.  
  140. /*<       dimension string(1) >*/
  141. /*<       dimension aout(19),lenout(19),aopt(5),lenopt(5) >*/
  142. /*<       data aout / 6hv     , 6hvm    , 6hvr    , 6hvi    , 6hvp    , >*/
  143. /*<      1            6hvdb   , 6hi     , 6him    , 6hir    , 6hii    , >*/
  144. /*<      2            6hip    , 6hidb   , 6honoise, 6hinoise, 6hhd2   , >*/
  145. /*<      1            6hhd3   , 6hdim2  , 6hsim2  , 6hdim3   / >*/
  146. /*<       data lenout / 1,2,2,2,2,3,1,2,2,2,2,3,6,6,3,3,4,4,4 / >*/
  147. /*<       data aopt / 5hmag  , 5hreal , 5himag , 5hphase, 5hdb    / >*/
  148. /*<       data lenopt / 3,4,4,5,2 / >*/
  149. /*<       data alprn, acomma, arprn, ablnk / 1h(, 1h,, 1h), 1h  / >*/
  150.  
  151.  
  152. /*<       ioutyp=nodplc(loc+5) >*/
  153.     ioutyp = nodplc[*loc + 4];
  154. /*<       if (ioutyp.ge.2) go to 10 >*/
  155.     if (ioutyp >= 2) {
  156.     goto L10;
  157.     }
  158. /*<       lout=ktype+ioutyp*6 >*/
  159.     lout = *ktype + ioutyp * 6;
  160. /*<       go to 20 >*/
  161.     goto L20;
  162. /*<    10 lout=ioutyp+11 >*/
  163. L10:
  164.     lout = ioutyp + 11;
  165. /*<    20 call move(string,ipos,aout(lout),1,lenout(lout)) >*/
  166. L20:
  167.     move_(&string[1], ipos, &aout[lout - 1], &c__1, &lenout[lout - 1]);
  168. /*<       ipos=ipos+lenout(lout) >*/
  169.     *ipos += lenout[lout - 1];
  170. /*<       if (ioutyp.ge.2) go to 200 >*/
  171.     if (ioutyp >= 2) {
  172.     goto L200;
  173.     }
  174. /*<       call move(string,ipos,alprn,1,1) >*/
  175.     move_(&string[1], ipos, &alprn, &c__1, &c__1);
  176. /*<       ipos=ipos+1 >*/
  177.     ++(*ipos);
  178. /*<       if (ioutyp.ne.0) go to 100 >*/
  179.     if (ioutyp != 0) {
  180.     goto L100;
  181.     }
  182. /*<       node1=nodplc(loc+2) >*/
  183.     node1 = nodplc[*loc + 1];
  184. /*<       call alfnum(nodplc(junode+node1),string,ipos) >*/
  185.     alfnum_(&nodplc[tabinf_1.junode + node1 - 1], &string[1], ipos);
  186. /*<       node2=nodplc(loc+3) >*/
  187.     node2 = nodplc[*loc + 2];
  188. /*<       if (node2.eq.1) go to 30 >*/
  189.     if (node2 == 1) {
  190.     goto L30;
  191.     }
  192. /*<       call move(string,ipos,acomma,1,1) >*/
  193.     move_(&string[1], ipos, &acomma, &c__1, &c__1);
  194. /*<       ipos=ipos+1 >*/
  195.     ++(*ipos);
  196. /*<       call alfnum(nodplc(junode+node2),string,ipos) >*/
  197.     alfnum_(&nodplc[tabinf_1.junode + node2 - 1], &string[1], ipos);
  198. /*<    30 call move(string,ipos,arprn,1,1) >*/
  199. L30:
  200.     move_(&string[1], ipos, &arprn, &c__1, &c__1);
  201. /*<       ipos=ipos+1 >*/
  202.     ++(*ipos);
  203. /*<       go to 1000 >*/
  204.     goto L1000;
  205.  
  206. /*<   100 locv=nodplc(loc+1) >*/
  207. L100:
  208.     locv = nodplc[*loc];
  209. /*<       anam=value(locv) >*/
  210.     anam = blank_1.value[locv - 1];
  211. /*<       achar=ablnk >*/
  212.     achar = ablnk;
  213. /*<       do 110 i=1,8 >*/
  214.     for (i = 1; i <= 8; ++i) {
  215. /*<       call move(achar,1,anam,i,1) >*/
  216.     move_(&achar, &c__1, &anam, &i, &c__1);
  217. /*<       if (achar.eq.ablnk) go to 120 >*/
  218.     if (achar == ablnk) {
  219.         goto L120;
  220.     }
  221. /*<       call move(string,ipos,achar,1,1) >*/
  222.     move_(&string[1], ipos, &achar, &c__1, &c__1);
  223. /*<       ipos=ipos+1 >*/
  224.     ++(*ipos);
  225. /*<   110 continue >*/
  226. /* L110: */
  227.     }
  228. /*<   120 call move(string,ipos,arprn,1,1) >*/
  229. L120:
  230.     move_(&string[1], ipos, &arprn, &c__1, &c__1);
  231. /*<       ipos=ipos+1 >*/
  232.     ++(*ipos);
  233. /*<       go to 1000 >*/
  234.     goto L1000;
  235.  
  236. /*<   200 if (ktype.eq.1) go to 1000 >*/
  237. L200:
  238.     if (*ktype == 1) {
  239.     goto L1000;
  240.     }
  241. /*<       call move(string,ipos,alprn,1,1) >*/
  242.     move_(&string[1], ipos, &alprn, &c__1, &c__1);
  243. /*<       ipos=ipos+1 >*/
  244.     ++(*ipos);
  245. /*<       call move(string,ipos,aopt(ktype-1),1,lenopt(ktype-1)) >*/
  246.     move_(&string[1], ipos, &aopt[*ktype - 2], &c__1, &lenopt[*ktype - 2]);
  247. /*<       ipos=ipos+lenopt(ktype-1) >*/
  248.     *ipos += lenopt[*ktype - 2];
  249. /*<       call move(string,ipos,arprn,1,1) >*/
  250.     move_(&string[1], ipos, &arprn, &c__1, &c__1);
  251. /*<       ipos=ipos+1 >*/
  252.     ++(*ipos);
  253.  
  254. /*  finished */
  255.  
  256. /*<  1000 return >*/
  257. L1000:
  258.     return 0;
  259. /*<       end >*/
  260. } /* outnam_ */
  261.  
  262. #undef cvalue
  263. #undef nodplc
  264. #undef arprn
  265. #undef acomma
  266. #undef alprn
  267. #undef aopt
  268. #undef aout
  269. #undef ablnk
  270.  
  271.  
  272.